home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Serious Software / Cherwell Scientific Demos / pro Fit / pro Fit 5.0 demo (fpu).sea / pro Fit 5.0 demo (fpu) / Functions & Programs / •Gadgets / Data Reduction for log scale < prev    next >
Text File  |  1996-06-01  |  2KB  |  59 lines
  1. {
  2.  this is a data reduction program that takes a (x,y) data
  3.  set and replaces it with a data set whose points are
  4.  equally spaced in the x-coordinate when plotted on a logarithmic
  5.  x-axis.
  6.  This program keeps the number of points in each decade 
  7.  constant by averaging over all the points found in the interval
  8.  [x, x*a], where a>1 is an input parameter.
  9.  
  10.  To use this program, choose "Add To Menu" from the Misc menu
  11.  (or click the Add button).
  12.  Then choose the program's name from the Misc menu.
  13.  
  14. }
  15.  
  16. program logreduction;
  17.  
  18. var Cx,Cy,count,count1,count2,Limit,xx,yy,sumx,sumy,buf,a:extended;
  19.                 
  20. procedure initialize;
  21. begin
  22.     a:=1.2;
  23. end;
  24.  
  25. begin
  26.  Cx:=xColumn;
  27.  Cy:=yColumn;
  28.  SetBoxTitle('Log scale data reduction');
  29.  input('$CX Column',Cx,'$CY Column', Cy, 'multiplication factor', a);
  30.  if ColEmpty(Cx) or ColEmpty(Cy) then
  31.  begin
  32.      beep;
  33.      exit;
  34.  end;
  35.     count1:=1;
  36.     while not  dataok(count1,Cx) and dataok(count1,Cy) do count1:=count1+1;
  37.     count2:=1;
  38.  xx:=data[count1,Cx];
  39.  yy:=data[count1,Cy];
  40.  repeat 
  41.   Limit:=xx*a;count:=0;sumx:=0;sumy:=0;
  42.   repeat
  43.       if dataok(count1+count+1,Cx) then
  44.       begin
  45.           sumx:=sumx+xx;sumy:=sumy+yy;
  46.           count:=count+1;buf:=count+count1;
  47.           xx:=data[buf,Cx];{this data is always good}
  48.           yy:=data[buf,Cy];
  49.          end else begin count1:=count1+1;buf:=count+count1 end;
  50.      until (xx>Limit) or (buf+1>NrRows);
  51.      count1:=buf;
  52.      if count>0 then begin data[count2,Cx]:=sumx/count;data[count2,Cy]:=sumy/count end
  53.         else begin data[count2,Cx]:=xx;data[count2,Cy]:=yy end;
  54.      count2:=count2+1;
  55.  until count1+1>NrRows;
  56.  for buf:=count2 to NrRows do
  57.     if dataok(buf,Cx) then begin Cleardata(buf,Cx);Cleardata(buf,Cy) end;
  58. end;
  59.